(ns win.gui-test
  (:use jna
        jna.win.user32
        jna.win.kernel32
        jna.mekit)
  (:use util.utils))

;;;
;;; A (simpler, of course...) copy of Perl's Win32::GuiTest:
;;; http://search.cpan.org/dist/Win32-GuiTest/lib/Win32/GuiTest.pm
;;; http://search.cpan.org/~karasik/Win32-GuiTest/lib/Win32/GuiTest/Examples.pm
;;; http://www.piotrkaluski.com/files/winguitest/docs/winguitest.html
;;;

;;; TODO: menu, review and update to Win32::GuiTest 1.57...

(alias 'user32 'jna.win.user32)

(export
  PostMessage SendMessage
  GetDesktopWindow GetChildWindows GetChildWindowTree GetDirectChildWindows
  GetWindowText GetClassName GetWindowID GetWindowProcessId
  FindWindowLike FindTopWindowLike
  SetForegroundWindow GetForegroundWindow SetActiveWindow
  GetWindowRect
  )

(export SendKeys)

;;; buttons

(defn PushChildButton
  ([parent button delay]
    (let [child (as-one
                  (filter #(or (re-find button (GetWindowText %))
                               (= button (GetWindowID %)))
                    (GetChildWindows parent)))]
      (PostMessage child WM_LBUTTONDOWN)
      (when delay
        (sleep-milliseconds delay))
      (PostMessage child WM_LBUTTONUP)))
  ([parent button]
    (PushChildButton parent button nil)))

(defn PushButton
  ([button delay]
    (PushChildButton (GetForegroundWindow) button delay))
  ([button]
    (PushButton button nil)))

(defn simple_mouse [dwFlags dx dy]
  (mouse_event dwFlags dx dy 0 native-0)
  (sleep-milliseconds 10)) ; XXX: why sleep 10?

(defn SendLButtonUp []
  (simple_mouse MOUSEEVENTF_LEFTUP 0 0))

(defn SendLButtonDown []
  (simple_mouse MOUSEEVENTF_LEFTDOWN 0 0))

(defn SendMButtonUp []
  (simple_mouse MOUSEEVENTF_MIDDLEUP 0 0))

(defn SendMButtonDown []
  (simple_mouse MOUSEEVENTF_MIDDLEDOWN 0 0))

(defn SendRButtonUp []
  (simple_mouse MOUSEEVENTF_RIGHTUP 0 0))

(defn SendRButtonDown []
  (simple_mouse MOUSEEVENTF_RIGHTDOWN 0 0))

(defn SendMouseMoveRel [x y]
  (simple_mouse MOUSEEVENTF_MOVE x y))

(defn SendMouseMoveAbs [x y]
  (simple_mouse (bit-or MOUSEEVENTF_MOVE MOUSEEVENTF_ABSOLUTE) x y))

(defn MouseMoveAbsPix [x y]
  (let [mickey_x (MulDiv x 0x10000 (GetSystemMetrics SM_CXSCREEN))
        mickey_y (MulDiv y 0x10000 (GetSystemMetrics SM_CYSCREEN))]
    (simple_mouse (bit-or MOUSEEVENTF_MOVE MOUSEEVENTF_ABSOLUTE) mickey_x mickey_y)))


(defn SendMouse [command]
  (doseq [item (map second (re-seq #"\{(.+?)\}" command))]
    (let [i (.toLowerCase item)]
      (condp = i
        "leftdown"       (SendLButtonDown)
        "leftup"         (SendLButtonUp)
        "middledown"     (SendMButtonDown)
        "middleup"       (SendMButtonUp)
        "rightdown"      (SendRButtonDown)
        "rightup"        (SendRButtonUp)
        "leftclick"      (do (SendLButtonDown) (SendLButtonUp))
        "middleclick"    (do (SendMButtonDown) (SendMButtonUp))
        "rightclick"     (do (SendRButtonDown) (SendRButtonUp))
        (cond
          (re-matches #"abs(-?\d+),(-?\d+)" i) (let [[_ x y] (re-matches #"abs(-?\d+),(-?\d+)" i)]
                                                 (SendMouseMoveAbs (Integer/parseInt x) (Integer/parseInt y)))
          (re-matches #"rel(-?\d+),(-?\d+)" i) (let [[_ x y] (re-matches #"abs(-?\d+),(-?\d+)" i)]
                                                 (SendMouseMoveRel (Integer/parseInt x) (Integer/parseInt y)))
          :else (throw (Exception. "GuiTest: Unmatched mouse command!")))))))


;;; windows

(defn SetForegroundWindow [hWnd]
  (if (IsIconic hWnd)
    (ShowWindow hWnd SW_RESTORE)
    (user32/SetForegroundWindow hWnd)))

(defn- AttachWin [hwnd fAttach]
  (AttachThreadInput (GetWindowThreadId hwnd) (GetCurrentThreadId) (boolean fAttach)))

(defn SetActiveWindow [hWnd]
  (AttachWin hWnd true)
  (user32/SetActiveWindow hWnd)
  (AttachWin hWnd false))

;;; controls

(defn WMGetText [hWnd]
  (let [n (SendMessage hWnd WM_GETTEXTLENGTH)
        buffer (jna-array-new :WCHAR (inc n))]
    (SendMessage hWnd WM_GETTEXT (inc n) (com.sun.jna.Pointer/nativeValue (address-of buffer)))
    (jna-to-string buffer 0 n)))

